home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 014 / pibcat.arc / PIBCATA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-20  |  11.1 KB  |  257 lines
  1. (*----------------------------------------------------------------------*)
  2. (*     Display_Archive_Contents --- Display contents of archive file    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Archive_Contents( ArcFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Archive_Contents                               *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of an archive (.ARC file)            *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Archive_Contents( ArcFileName : AnyStr );              *)
  16. (*                                                                      *)
  17. (*          ArcFileName --- name of archive file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Long_To_Real      --- convert long (32 bit) INTEGER to real *)
  25. (*          Dir_Convert_Date  --- convert DOS packed date to string     *)
  26. (*          Dir_Convert_Time  --- convert DOS packed time to string     *)
  27. (*          Display_File_Info --- display information about a file      *)
  28. (*          Open_File         --- open a file                           *)
  29. (*          Close_File        --- close a file                          *)
  30. (*                                                                      *)
  31. (*----------------------------------------------------------------------*)
  32.  
  33. (*----------------------------------------------------------------------*)
  34. (*                  Map of Archive file entry header                    *)
  35. (*----------------------------------------------------------------------*)
  36.  
  37. TYPE
  38.    Archive_Entry_Type = RECORD
  39.                            Marker   : BYTE      (* Flags beginning of entry *);
  40.                            Version  : BYTE      (* Compression method       *);
  41.                            Filename : ARRAY[1..13] OF CHAR  (* file and extension *);
  42.                            Size     : LongInt   (* Compressed size *);
  43.                            Date     : INTEGER   (* Packed date *);
  44.                            Time     : INTEGER   (* Packed time *);
  45.                            CRC      : INTEGER   (* Cyclic Redundancy Check *);
  46.                            OLength  : LongInt   (* Original length *);
  47.                         END;
  48.  
  49. CONST
  50.    Archive_Header_Length = 29      (* Length of an archive header entry *);
  51.    Archive_Marker        = 26      (* Marks start of an archive header  *);
  52.  
  53. VAR
  54.    ArcFile       : FILE                 (* Archive file to be read        *);
  55.    Archive_Entry : Archive_Entry_Type   (* Header for one file in archive *);
  56.    Archive_Pos   : REAL                 (* Current byte offset in archive *);
  57.    Bytes_Read    : INTEGER              (* # bytes read from archive file *);
  58.    Ierr          : INTEGER              (* Error flag                     *);
  59.  
  60. (*----------------------------------------------------------------------*)
  61. (*   Get_Next_Archive_Entry --- Get next header entry in archive        *)
  62. (*----------------------------------------------------------------------*)
  63.  
  64. FUNCTION Get_Next_Archive_Entry( VAR ArcEntry : Archive_Entry_Type;
  65.                                  VAR Error    : INTEGER ) : BOOLEAN;
  66.  
  67. (*----------------------------------------------------------------------*)
  68. (*                                                                      *)
  69. (*    Function:  Get_Next_Archive_Entry                                 *)
  70. (*                                                                      *)
  71. (*    Purpose:   Gets header information for next file in archive       *)
  72. (*                                                                      *)
  73. (*    Calling sequence:                                                 *)
  74. (*                                                                      *)
  75. (*       OK := Get_Next_Archive_Entry( VAR ArcEntry :                   *)
  76. (*                                         Archive_Entry_Type;          *)
  77. (*                                     VAR Error    : INTEGER );        *)
  78. (*                                                                      *)
  79. (*          ArcEntry --- Header data for next file in archive           *)
  80. (*          Error    --- Error flag                                     *)
  81. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  82. (*                                                                      *)
  83. (*----------------------------------------------------------------------*)
  84.  
  85. BEGIN (* Get_Next_Archive_Entry *)
  86.                                    (* Assume no error to start *)
  87.    Error := 0;
  88.                                    (* Except first time, move to     *)
  89.                                    (* next supposed header record in *)
  90.                                    (* archive.                       *)
  91.  
  92.    IF ( Archive_Pos <> 0.0 ) THEN
  93.       LongSeek( ArcFile, Archive_Pos );
  94.  
  95.                                    (* Read in the file header entry. *)
  96.  
  97.    BlockRead( ArcFile, ArcEntry, Archive_Header_Length, Bytes_Read );
  98.    Error := 0;
  99.                                    (* If wrong size read, or header marker *)
  100.                                    (* byte is incorrect, report archive    *)
  101.                                    (* format error.                        *)
  102.  
  103.    IF ( ( Bytes_Read < Archive_Header_Length ) OR
  104.         ( ArcEntry.Marker <> Archive_Marker ) ) THEN
  105.       Error := Format_Error
  106.    ELSE                            (* Header looks ok -- see if it *)
  107.                                    (* is the end of file marker.   *)
  108.  
  109.       IF ( ArcEntry.Version = 0 ) THEN
  110.          Error := End_Of_File
  111.       ELSE                         (* Not end of file marker -- get entry data. *)
  112.          WITH ArcEntry DO
  113.             BEGIN
  114.                                    (* Get position of next archive header *)
  115.  
  116.                Archive_Pos := Archive_Pos + Long_To_Real( Size ) +
  117.                               Archive_Header_Length;
  118.  
  119.                                    (* Adjust for older archives *)
  120.  
  121.                IF ( Version = 1 ) THEN
  122.                   BEGIN
  123.                      OLength     := Size;
  124.                      Version     := 2;
  125.                      Archive_Pos := Archive_Pos - 2.0;
  126.                   END;
  127.  
  128.             END;
  129.                                     (* Report success/failure to calling *)
  130.                                     (* routine.                          *)
  131.  
  132.    Get_Next_Archive_Entry := ( Error = 0 );
  133.  
  134. END   (* Get_Next_Archive_Entry *);
  135.  
  136. (*----------------------------------------------------------------------*)
  137. (*      Display_Archive_Entry --- Display archive header entry          *)
  138. (*----------------------------------------------------------------------*)
  139.  
  140. PROCEDURE Display_Archive_Entry( Archive_Entry : Archive_Entry_Type );
  141.  
  142. VAR
  143.    SDate      : STRING[10];
  144.    STime      : STRING[12];
  145.    I          : INTEGER;
  146.    FName      : AnyStr;
  147.    RLength    : REAL;
  148.  
  149. BEGIN (* Display_Archive_Entry *)
  150.  
  151.    WITH Archive_Entry DO
  152.       BEGIN
  153.                                    (* Pick up file name *)
  154.  
  155.          Fname := COPY( FileName, 1, POS( #0 , FileName ) - 1 );
  156.  
  157.                                    (* Get original file size *)
  158.  
  159.          RLength := Long_To_Real( Olength );
  160.  
  161.                                    (* Get date and time of creation *)
  162.  
  163.          Dir_Convert_Date( Date , SDate );
  164.          Dir_Convert_Time( Time , STime );
  165.  
  166.                                    (* Write out file name, length, date, time *)
  167.  
  168.          WRITE( Output_File , Left_Margin_String, '      ' , FName );
  169.  
  170.          FOR I := LENGTH( FName ) TO 13 DO
  171.             WRITE( Output_File , ' ' );
  172.  
  173.          WRITE  ( Output_File , RLength:8:0, '  ' );
  174.          WRITE  ( Output_File , SDate, '  ' );
  175.          WRITE  ( Output_File , STime );
  176.          WRITELN( Output_File );
  177.  
  178.                                    (* Count lines left on page *)
  179.          IF Do_Printer_Format THEN
  180.             BEGIN
  181.                Lines_Left := Lines_Left - 1;
  182.                IF ( Lines_Left < 1 ) THEN
  183.                   Display_Page_Titles;
  184.             END;
  185.  
  186.       END;
  187.  
  188. END (* Display_Archive_Entry *);
  189.  
  190. (*----------------------------------------------------------------------*)
  191.  
  192. BEGIN (* Display_Archive_Contents *)
  193.  
  194.                                    (* Set left margin spacing *)
  195.  
  196.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , ArcLbr_Indent );
  197.  
  198.                                    (* Set file title *)
  199.  
  200.    File_Title := Left_Margin_String + ' Archive file: ' + ArcFileName;
  201.  
  202.                                    (* Display archive file's name *)
  203.    IF Do_Printer_Format THEN
  204.       IF ( Lines_Left < 3 ) THEN
  205.          Display_Page_Titles;
  206.  
  207.    WRITELN( Output_File ) ;
  208.    WRITE  ( Output_File , File_Title );
  209.  
  210.    IF Do_Printer_Format THEN
  211.       Lines_Left := Lines_Left - 2;
  212.  
  213.                                    (* Try opening archive file for processing *)
  214.  
  215.    Open_File( ArcFileName , ArcFile, Archive_Pos, Ierr );
  216.  
  217.                                    (* Issue error message if open fails *)
  218.    IF ( Ierr <> 0 ) THEN
  219.       BEGIN
  220.          WRITELN( Output_File , DUPL( ' ' , 13 - LENGTH( ArcFileName ) ),
  221.                                 '     Can''t open archive file ',ArcFileName );
  222.          IF Do_Printer_Format THEN
  223.             BEGIN
  224.                Lines_Left := Lines_Left - 1;
  225.                IF ( Lines_Left < 1 ) THEN
  226.                   Display_Page_Titles;
  227.             END;
  228.          EXIT;
  229.       END
  230.    ELSE
  231.       BEGIN
  232.          WRITELN( Output_File );
  233.          WRITELN( Output_File );
  234.                                    (* Count lines left on page *)
  235.          IF Do_Printer_Format THEN
  236.             BEGIN
  237.                Lines_Left := Lines_Left - 1;
  238.                IF ( Lines_Left < 1 ) THEN
  239.                   Display_Page_Titles;
  240.             END;
  241.       END;
  242.                                    (* Loop over entries in archive file *)
  243.  
  244.    WHILE( Get_Next_Archive_Entry( Archive_Entry , Ierr ) ) DO
  245.       Display_Archive_Entry( Archive_Entry );
  246.  
  247.                                    (* Close archive file *)
  248.    Close_File( ArcFile );
  249.                                    (* Restore previous left margin spacing *)
  250.  
  251.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  252.  
  253.                                    (* No file title *)
  254.    File_Title := '';
  255.  
  256. END   (* Display_Archive_Contents *);
  257.